C/C++ Users Group Library 1996 July/C-C++ Users Group Library July 1996.iso/vol_200/297_02/sprolog.ini

Text File | 1991-12-23 | 4.5 KB | 226 lines

/* sprolog.ini */
/* This file gets loaded when Small Prolog starts up */

/* negation by failure */
((not X)
 X (cut) (fail))
((not X))

/* membership in a list */
((member X (X|Y))
)
((member X (A|B))
 (member X B)
)

/* unify both arguments */
((eq X X))

/* test if not unifiable */
((diff X X)(cut)(fail)
)
((diff X Y))

/* append two lists */
((append (A|X) Y (A|Z))
 (append X Y Z)
)
((append () X X))

/* naive reverse -a classic inefficient algorithm */

((nrev (X|Y) U)
 (nrev Y L)(append L (X) U)
)
((nrev ()()))

/* a benchmark - clock may not work on all systems */
((bench)
 (clock T1)
 (n_unifications Nu1)
 (nrev (1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0)L)
 (clock T2)
 (n_unifications Nu2)
 (iminus T2 T1 Tdiff)
 (iminus Nu2 Nu1 Nudiff)
 (display L)(nl)
 (display Nudiff)(writes " unifications in ")
 (display Tdiff)(writes " microseconds.")(nl)
)

/* List is the list of all facts corresponding to Predicate */
((all_facts (Predicate|Args) List)
 (first_clause Predicate Clause)
 (cut)
 (allfacts1 Clause Args List)
)
((all_facts X ()))

((allfacts1 Clause Args ((Pred|ArgsHead)|L))
 (body_clause Clause ((Pred|ArgsHead)))
 (unifies ArgsHead Args)
 (cut)
 (allfacts2  Clause Args L)
)

((allfacts2 Clause Args L)
 (next_clause Clause Clause2)
 (cut)
 (allfacts1 Clause2 Args L)
)
((allfacts2 Clause Args ()))

/* Nondeterministic : unifies arguments to all possible
 * Clause-head and clause tails respectively
*/
((clause (Predicate|Args) Goals)
 (atom Predicate)/* Predicate known */
 (cut)
 (choose_clause Predicate Clause)/* Clause backtracks though Clauses */
 (body_clause Clause ((Predicate|Args)|Goals))/* this is a builtin */
)

((clause (Predicate|Args) Goals)
 (predicate Predicate)
 (choose_clause Predicate Clause)
 (body_clause Clause ((Predicate|Args)|Goals))
)


((predicate P) /* predicate enumerates all predicates P */
 (first_predicate Pred1) /* builtin */
 (predicates_after Pred1 P )
)

((predicates_after P P))
((predicates_after Pred P)
 (next_predicate Pred Next)/* builtin */
 (predicates_after Next P)
)

((choose_clause Predicate Clause)
 (first_clause Predicate Clause1)
 (clause_after Clause1 Clause)
)
(clause_after Clause1 Clause1)
((clause_after Clause1 Clause)/* builtin */
 (next_clause Clause1 Clause2)
 (clause_after Clause2 Clause)
)

/* test if terms are unifiable but throws away bindings */
((unifies X Y)(diff X Y)(cut)(fail))
((unifies X Y))


((retract (Head | Tail))/* handles unit clauses only for the time */
 (atom Head)
 (retract1 Head Tail)
)

((retract1 Predicate Tail)
 (find_clause Predicate Clause)
 (body_clause Clause ((Predicate | Tail)) )
 (remove_clause Clause)
)

((find_clause Predicate Clause)
 (first_clause Predicate Clause1)
 (find_clause1 Clause1 Clause)
)

(find_clause1 Clause_a Clause_a)
((find_clause1 Clause_a Clause)
 (next_clause Clause_a Clause_b)
 (find_clause1 Clause_b Clause)
)


/* no fixed arity version of conjunction  */
((and))
((and X | Y)
 X
 (and Y)
)
/* binary version */
((binary_or X _) X)
((binary_or _ Y) Y)

/* general version */
((or X|_) X)
((or _|Y)(or | Y))

/* see Clocsin & Mellish
   25/12/91 this is now a builtin
((repeat))
((repeat)(repeat))
*/
/* find out how much room is left */
((statistics)
 (space_left Heap Str Dyn Subst Trail Temp)
 (there_remains Heap "heap")
 (there_remains Str "strings")
 (there_remains Dyn "contol stack")
 (there_remains Subst "substitutions")
 (there_remains Trail "trail")
 (there_remains Temp "temp")
)

((there_remains Bytes Zone)
 (writes "There remains ")
 (display Bytes)
 (writes " bytes for the ")
 (writes Zone)
 (writes ".")
 (nl)
)

/* calculate the nth element of list */
(list_nth 0 (X|_) X)
((list_nth N (_|Y) X)
 (iminus N 1 N-1)
 (list_nth N-1 Y X)
)

/* sum a list of integers
 * The result is the first argument
 */
((sum 0 )(cut))
((sum S X|Y)
 (sum S1| Y)
 (iplus S1 X S)
)

/* This is from Clocksin and Mellish
 * It is not very fast.
 * We use temp_asserta so that the memory can be cleaned with
 * clean_temp
 */
((findall X G _)
/* (suspend_trace) */
 (temp_asserta (found mark))
 G
 (temp_asserta (found X))
 (fail)
)
((findall _ _ L)
 (collect_found () M)
 (cut)
 (eq L M)
/* (resume_trace) */
)

((collect_found S L)
 (getnext X)
 (cut)
 (collect_found (X|S) L)
)
(collect_found L L)

((getnext X)
 (retract (found X))
 (cut)
 (diff X mark)
)